home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / clp.exe / D.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-07  |  7KB  |  228 lines
  1. { ========================================================================= }
  2. {                                                                           }
  3. {                                                                           }
  4. {                     !!!!!      !!!!!!                                     }
  5. {                      !! !!      !!  !!                                    }
  6. {                      !!  !!     !!  !!  !!!!    !!!!!                     }
  7. {                      !!  !!     !!  !!     !!  !!   !!                    }
  8. {                      !!  !!     !!!!!   !!!!!   !!!                       }
  9. {                      !!  !!     !!     !!  !!     !!!                     }
  10. {                      !! !!  !!  !!     !!  !!  !!   !!                    }
  11. {                     !!!!!   !! !!!!     !!! !!  !!!!!                     }
  12. {                                                                           }
  13. {                         CLParser v3.20 CARGO Demo                         }
  14. {                                                                           }
  15. { ========================================================================= }
  16. {                   Copyright (c) 1989,1992 Greg Truesdell                  }
  17. { ========================================================================= }
  18. Program Directory;
  19.  
  20. Uses
  21.     { !! THIS SAMPLE FILE REQUIRES OBJECT PROFESSIONAL TO COMPILE !! }
  22.     OpCrt, OpDate, OpString,
  23.  
  24.     Dos,
  25.     CLParser;
  26.  
  27. { ========================================================================= }
  28. {                   G L O B A L   D E C L A R A T I O N S                   }
  29. { ========================================================================= }
  30.  
  31. Type
  32.     String80 = String[80];
  33.     String4  = String[4];
  34.  
  35. Const
  36.     QuietMode   : Boolean = FALSE;      { quiet mode operation }
  37.     DefPath     : String80 = '*.*';
  38.  
  39. Var
  40.     pArg    : pArgument;    { arguments }
  41.     pSw     : pArgument;    { switches }
  42.     pDir    : pWild;        { directory list }
  43.  
  44.  
  45. { ========================================================================= }
  46. {                             E R R O R E X I T                             }
  47. { ========================================================================= }
  48. Procedure ErrorExit( msg : String80 );
  49. begin
  50.  
  51.     WriteLn( msg );
  52.     Halt(1);
  53.  
  54. end;
  55.  
  56. { ========================================================================= }
  57. {                            I N I T I A L I Z E                            }
  58. { ========================================================================= }
  59. Procedure Initialize;
  60. var
  61.     sw : String80;
  62.     ii : Word;
  63. begin
  64.  
  65.     { initialize the command line objects }
  66.  
  67.     pArg := New( pArgument, Init( NormalChars-Switches ) );
  68.     pSw  := New( pArgument, Init( Switches ) );
  69.  
  70.     if (pArg=Nil) or (pSw=Nil) then
  71.         ErrorExit('Commandline init failure: Not enough memory!');
  72.  
  73.     { begin parsing switches }
  74.  
  75.     if pSw^.Count > 0 then with pSw^ do for ii := 1 to Count do
  76.     begin
  77.  
  78.         sw := '  ';
  79.         sw := Next;
  80.  
  81.         case UpCase(sw[2]) of
  82.  
  83.             'Q' : { Quiet Mode }
  84.                 QuietMode := True;
  85.  
  86.  
  87.             'R' : { redirect output }
  88.                 begin
  89.                     Assign(OutPut,'');
  90.                     ReWrite(OutPut);
  91.                 end;
  92.                     
  93.         end;
  94.  
  95.     end;
  96.  
  97.     { parse filenames etc }
  98.  
  99.     if pArg^.Count > 0 then with pArg^ do
  100.     begin
  101.  
  102.         DefPath := Next;
  103.         if JustFilename(DefPath) = '' then
  104.             DefPath := DefPath + '*.*';
  105.  
  106.     end;
  107.  
  108.     { free memory }
  109.  
  110.     Dispose( pSw, Done );
  111.     Dispose( pArg, Done );
  112.  
  113. end;
  114.  
  115. { ========================================================================= }
  116. {                          C O N V E R T   D A T E                          }
  117. { ========================================================================= }
  118. Function ConvertDate( Julian : Date ) : String80;
  119. var
  120.     dt    : DateTime;
  121.     dTime : Time;
  122.     dDate : Date;
  123. begin
  124.  
  125.     UnPackTime( Julian, dt );
  126.     with dt do
  127.     begin
  128.  
  129.         dTime := HMStoTime( Hour, Min, Sec );
  130.         dDate := DMYtoDate( Day, Month, Year );
  131.  
  132.     end;
  133.  
  134.     ConvertDate := DateToDateString( 'mm-dd-yy', dDate ) + ' ' +
  135.         TimeToTimeString( 'HH:mm:sst', dTime );
  136.  
  137. end;
  138.  
  139. { ========================================================================= }
  140. {                     C O N V E R T   A T T R I B U T E                     }
  141. { ========================================================================= }
  142. Function ConvertAttr( Attr : Byte ) : String4;
  143. var
  144.     st : String4;
  145. begin
  146.  
  147.     st := '____';
  148.     if (Attr and Archive)  > 0 then st[1] := 'A';
  149.     if (Attr and Hidden)   > 0 then st[2] := 'H';
  150.     if (Attr and ReadOnly) > 0 then st[3] := 'R';
  151.     if (Attr and SysFile)  > 0 then st[4] := 'S';
  152.  
  153.     ConvertAttr := st;
  154.  
  155. end;
  156.  
  157. { ========================================================================= }
  158. {                        D I R E C T O R Y   L I S T                        }
  159. { ========================================================================= }
  160. Procedure DirectoryList( dpath : String );
  161. var
  162.     Filename    : String80;
  163.     pSR         : ^SearchRec;
  164.     SRLen       : LongInt;
  165.     ii          : Word;
  166. begin
  167.  
  168.     { initialize the wildcard object }
  169.  
  170.     { ======================================================== }
  171.     {                                                          }
  172.     { NOTE:  The pWild object calls the AddCargo method using  }
  173.     {        the search record returned by the FindFirst() and }
  174.     {        FindNext() DOS unit procedures.                   }
  175.     {                                                          }
  176.     { ======================================================== }
  177.  
  178.     pDir := New( pWild, Init( dpath, AnyFile-VolumeID ) );
  179.  
  180.     { allocate space for the Search Record }
  181.  
  182.     GetMem( pSR, SizeOf(SearchRec) );
  183.  
  184.     if (pDir <> Nil) and (pSR <> Nil) then with pDir^ do
  185.     begin
  186.  
  187.         WriteLn('Directory for ' + fExpand(DefPath) );
  188.  
  189.         for ii := 1 to Count do
  190.         begin
  191.  
  192.             { get next filename and file info (as cargo) }
  193.  
  194.             Filename := NextCargo( Pointer(pSR), SRLen );
  195.  
  196.             { display a directory line }
  197.  
  198.             if (pSR^.Attr and Dos.Directory) = 0 then
  199.  
  200.                 WriteLn( Filename:16, pSR^.Size:8,' ',
  201.                     ConvertAttr( pSR^.Attr ), ' ', ConvertDate( pSR^.Time ) )
  202.  
  203.             else if (pSR^.Attr and VolumeID) = 0 then
  204.  
  205.                 WriteLn( StLoCase(Filename):16, '<DIR>':8,' ',
  206.                     ConvertAttr( pSR^.Attr ), ' ', ConvertDate( pSR^.Time ) )
  207.  
  208.         end;
  209.  
  210.     end;
  211.  
  212. end;
  213.  
  214. { ========================================================================= }
  215. {                                  M A I N                                  }
  216. { ========================================================================= }
  217. Begin
  218.  
  219.     Initialize;
  220.     DirectoryList( DefPath );
  221.  
  222. End.
  223.  
  224. { ========================================================================= }
  225. {                                   E O F                                   }
  226. { ========================================================================= }
  227.  
  228.